Prova 1 - Machine Learning
1 Questões Teóricas -
1.1 Questão:
Com suas palavras, explique o dilema de balanço entre víes e variância.
Resposta: De maneira resumida, é um conflito de escolhas. Se você deseja um modelo com um viés baixo infelizmente você terá um modelo de alta variância. Se você desejar um modelo com uma variância baixa infelizmente terá de lidar com um modelo enviesado.
1.2 Questão:
Explique resumidamente o que é aprendizagem supervisionada e não-supervisionada. Cite um problema de aprendizagem supervisionada e um outro de aprendizagem não-supervisionada.
Resposta: Aprendizagem supervisionada é tudo aquilo que você tem a resposta, já sabemos o “lugar” onde gostariamos de chegar. Exemplo prático: Certo banco de dados possui inúmeras medidas de animais diferentes e eu sei quais deles são ursos e quais não são, pode-se ajustar um modelo supervisionado, utilizando métodos de classificação.
Resposta: Já na aprendizagem não supervisionada não dispomos de um “objetivo” claro. Exemplo prático: Temos em mão dados de clientes de uma empresa e gostariamos de formar grupos de clientes com caracteristicas/gostos em comum para fornecermos um atendimento personalizado, com técnicas de clustering podemos formar N grupos diferentes e com a ajuda de um especialista devemos avaliar se esses grupos fazem sentido.
1.3 Questão:
Explique qual o motivo que faz com que o Erro Quadrático Médio - EQM para avaliar o desempenho de um modelo é ruim quando não adotamos nenhuma estratégia de divisão do conjunto de dados em treinamento e teste.
Resposta Porque assim não gozamos da independencia entre variáveis e por conta disso não vale a lei dos grandes números.
2 Questões Práticas -
2.1 Questão:
Considere o conjunto de dados de Expectativa de vida versus PIB per Capita. Considere a função g uma regressão polinomia. Utilizando o erro quadrático médio observado, sem fazer nenhuma estratégia de divisão dos dados, implemente um código em R para checar qual o melhor modelo. p = 1, …, 50.
Code
rm(list = ls())
dados_expectativa_renda <- read.csv("dados_expectativa_renda.csv")
set.seed(2023)
p = 50
dados_exp <- dados_expectativa_renda[,-1]
colnames(dados_exp) <- c("y", "x")
for(i in 1:p){
if(i > 1){
temp <- cbind(temp, temp[,2]^i)
colnames(temp) <- c("y", "x", paste0("x", 2:i))
fit <- lm(y~. , data = temp)
eqm[i] <- mean((temp$y - predict(fit, newdata = temp))^2)
i = i + 1
}
else{
fit <- lm(y~. , data = dados_exp)
eqm <- mean((dados_exp$y - predict(fit, newdata = dados_exp))^2)
temp <- dados_exp
}
}
eqm1 <- data.frame("P" = 1:50, "EQM" = eqm)
g <- ggplot(eqm1, aes(P, EQM)) +
geom_line(linetype = 2, size = 0.4) +
geom_point(size = 2, aes(colour = -EQM)) +
scale_fill_brewer(palette = 1) +
labs(x = "P", y = "EQM",
title = "Avaliação do EQM",
subtitle = "Sem repartir conjunto treino / teste")
g
2.2 Questão:
Refaça o exercício anterior do polinômio, utilizando a estratégia de data splitting, em que divide-se o conjunto de dados em treinamento e teste. Utilize o conjunto de teste para calcular a estimativa do risco, usando o EQM.
Code
rm(list = ls())
dados_expectativa_renda <- read.csv("dados_expectativa_renda.csv")
set.seed(2023)
p = 50
dados_exp <- dados_expectativa_renda[,-1]
colnames(dados_exp) <- c("y", "x")
dados_exp <- initial_split(dados_exp, prop = 3/4)
trainer <- training(dados_exp)
tester <- testing(dados_exp)
eqm2 = data.frame(P = 1:50, y = NA)
for(i in 1:p){
if(i > 1){
trainer <- cbind(trainer, trainer[,2]^i)
colnames(trainer) <- c("y", "x", paste0("x", 2:i))
fit <- lm(y~., trainer)
## Avaliando no conjunto de teste
tester <- cbind(tester, tester[,2]^i)
colnames(tester) <- c("y", "x", paste0("x", 2:i))
eqm2[i,2] <- mean((tester[,1] - predict(fit, tester))^2)
}
else{
fit <- lm(y~., trainer)
eqm2[i,2] <- mean((tester[,1] - predict(fit, tester))^2)
}
}
colnames(eqm2) <- c("P", "EQM")
g <- ggplot(eqm2, aes(P, EQM)) +
geom_line(linetype = 2, size = 0.4) +
geom_point(size = 2, aes(colour = -EQM)) +
labs(x = "P", y = "EQM",
title = "Avaliação do EQM",
subtitle = "Repartindo conjunto treino/teste, sem validação cruzada") +
xlim(c(0,18)) + ylim(c(10,130))
g
2.3 Questão:
Ainda considerando o exercício do polinômio, implemente uma estratégia de leave-one-out cross-validation e selecione o melhor modelo minimizando a função de risco.
Code
rm(list = ls())
dados_expectativa_renda <- read.csv("dados_expectativa_renda.csv")
set.seed(2023)
p = 50
dados_exp <- dados_expectativa_renda[,-1]
colnames(dados_exp) <- c("y", "x")
dados_exp <- initial_split(dados_exp, prop = 3/4)
trainer <- training(dados_exp)
tester <- testing(dados_exp)
leave <- loo_cv(trainer)
results1 <- data.frame(P = NA, EQM = NA)
for(b in 1:dim(leave)[1]){
eqm <- NULL
for(i in 1:p){
if(i > 1){
temp_trainer <- leave$splits[[b]] %>% analysis()
temp_tester <- leave$splits[[b]] %>% assessment()
for(j in 2:i){
temp_trainer <- cbind(temp_trainer, temp_trainer$x^j)
temp_tester <- cbind(temp_tester, temp_tester$x^j)
colnames(temp_trainer) <- c("y", "x", paste0("x", 2:j))
colnames(temp_tester) <- c("y", "x", paste0("x", 2:j))
}
fit <- lm(y~., temp_trainer)
eqm[i] <- as.numeric((temp_tester[,1] - predict(fit, temp_tester))^2)
}
else{
temp_trainer <- leave$splits[[b]] %>% analysis()
temp_tester <- leave$splits[[b]] %>% assessment()
fit <- lm(y~., temp_trainer)
eqm[i] <- as.numeric((temp_tester[,1] - predict(fit, newdata = temp_tester))^2)
}
}
results1[b,1] <- which(eqm == min(eqm))[1]
results1[b,2] <- min(eqm)
}Resposta: Polinômio de Grau 7 apresentou o menor EQM, no valor de 4.5994799^{-6}.
2.4 Questão:
Por fim, considerando o exercício do polinômio, rafaça-o utilizando um procedimento de k-fold cross-validation. Considere k=5. Dica: considere utilizar a biblioteca rsample.
Code
rm(list = ls())
dados_expectativa_renda <- read.csv("dados_expectativa_renda.csv")
set.seed(2023)
p = 50
k = 5
dados_exp <- dados_expectativa_renda[,-1]
colnames(dados_exp) <- c("y", "x")
dados_exp <- initial_split(dados_exp, prop = 3/4)
trainer <- training(dados_exp)
tester <- testing(dados_exp)
vfold <- vfold_cv(trainer, v = 5)
results2 <- data.frame(P = NA, EQM = NA)
for(b in 1:dim(vfold)[1]){
eqm <- NULL
for(i in 1:p){
if(i > 1){
temp_trainer <- vfold$splits[[b]] %>% analysis()
temp_tester <- vfold$splits[[b]] %>% assessment()
for(j in 2:i){
temp_trainer <- cbind(temp_trainer, temp_trainer$x^j)
temp_tester <- cbind(temp_tester, temp_tester$x^j)
colnames(temp_trainer) <- c("y", "x", paste0("x", 2:j))
colnames(temp_tester) <- c("y", "x", paste0("x", 2:j))
}
fit <- lm(y~., temp_trainer)
eqm[i] <- mean((temp_tester[,1] - predict(fit, newdata = temp_tester))^2)
}
else{
temp_trainer <- vfold$splits[[b]] %>% analysis()
temp_tester <- vfold$splits[[b]] %>% assessment()
fit <- lm(y~., temp_trainer)
eqm[i] <- mean((temp_tester[,1] - predict(fit, newdata = temp_tester))^2)
}
}
results2[b,1] <- which(eqm == min(eqm))[1]
results2[b,2] <- min(eqm)
}Resposta: Polinômio de Grau 10 apresentou o menor EQM, no valor de 19.8729033 para o método k-fold, k=5.
2.5 Questão:
Utilizando os dados de vinho vermelho, faça uma pequena análise exploratória dos dados. No link do Kaggle você consegue uma explicação sobre o que significa cada uma das variáveis.
| Name | wine |
| Number of rows | 1599 |
| Number of columns | 12 |
| _______________________ | |
| Column type frequency: | |
| numeric | 12 |
| ________________________ | |
| Group variables | None |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| fixed.acidity | 0 | 1 | 8.32 | 1.74 | 4.60 | 7.10 | 7.90 | 9.20 | 15.90 | ▂▇▂▁▁ |
| volatile.acidity | 0 | 1 | 0.53 | 0.18 | 0.12 | 0.39 | 0.52 | 0.64 | 1.58 | ▅▇▂▁▁ |
| citric.acid | 0 | 1 | 0.27 | 0.19 | 0.00 | 0.09 | 0.26 | 0.42 | 1.00 | ▇▆▅▁▁ |
| residual.sugar | 0 | 1 | 2.54 | 1.41 | 0.90 | 1.90 | 2.20 | 2.60 | 15.50 | ▇▁▁▁▁ |
| chlorides | 0 | 1 | 0.09 | 0.05 | 0.01 | 0.07 | 0.08 | 0.09 | 0.61 | ▇▁▁▁▁ |
| free.sulfur.dioxide | 0 | 1 | 15.87 | 10.46 | 1.00 | 7.00 | 14.00 | 21.00 | 72.00 | ▇▅▁▁▁ |
| total.sulfur.dioxide | 0 | 1 | 46.47 | 32.90 | 6.00 | 22.00 | 38.00 | 62.00 | 289.00 | ▇▂▁▁▁ |
| density | 0 | 1 | 1.00 | 0.00 | 0.99 | 1.00 | 1.00 | 1.00 | 1.00 | ▁▃▇▂▁ |
| pH | 0 | 1 | 3.31 | 0.15 | 2.74 | 3.21 | 3.31 | 3.40 | 4.01 | ▁▅▇▂▁ |
| sulphates | 0 | 1 | 0.66 | 0.17 | 0.33 | 0.55 | 0.62 | 0.73 | 2.00 | ▇▅▁▁▁ |
| alcohol | 0 | 1 | 10.42 | 1.07 | 8.40 | 9.50 | 10.20 | 11.10 | 14.90 | ▇▇▃▁▁ |
| quality | 0 | 1 | 5.64 | 0.81 | 3.00 | 5.00 | 6.00 | 6.00 | 8.00 | ▁▇▇▂▁ |
Nosso banco de dados conta com 1599 observações e 12 variáveis numéricas, sendo 3 variáveis discretas e 9 contínuas. Abaixo uma breve descrição de cada uma das variáveis:
Acidez Fixa;
Acidez Volátil;
Ácido cítrico – É um ácido constituido das uvas que proporciona a sensação de frescor, podendo ser adicionado para aumentar a acidez;
Açúcar residual – Açucar que resta no vinho após sua fermentação alcoolíca;
Cloretos – São sais minerais;
Dióxido de enxofre livre – Químico responsável por evitar a oxidação do vinho;
Dióxido de enxofre total – Soma do dióxido de enxofre livre mais o combinado existente no vinho;
Densidade – É a massa volumêtrica do vinho sob a massa volumétrica da água;
Ph – Concentraçao de Ions de hidrogênio (H+) livres em uma solução de vinho;
Sulfatos;
Álcool – Quantidade de Alcool;
Qualidade – Uma pontuação entre 0 e 10;
2.6 Questão:
obtenha o melhor modelo de regressão linear para modelar a qualidade do vinho, considerando: Método dos Mínimos Quadrados, Regressão Ridge, Regressão Lasso, Elastic Net. Selecione o melhor modelo para cada uma das classes e contrua uma tabela com o risco estimado. Ao fim construir quatro gráficos mostrando cada um dos ajustes.
Code
rm(list = ls())
setwd("C:/Users/erald/Desktop/Faculdade/Aprendizagem de Maquina/machine_learning/")
wine <- read.csv("winequality-red.csv")
colnames(wine) <- c(paste0("x", 1:11), "y")
#Data split
wine <- initial_split(wine, prop = 3/4)
trainer <- training(wine)
tester <- testing(wine)
#Setting Engine
modelo_mmo <-
linear_reg(penalty = 0, mixture = 0) %>%
set_mode("regression") %>%
set_engine("glmnet")
modelo_ridge <-
linear_reg(penalty = tune::tune(), mixture = 0) %>%
set_mode("regression") %>%
set_engine("glmnet")
modelo_lasso <-
parsnip::linear_reg(penalty = tune::tune(), mixture = 1) %>%
set_mode("regression") %>%
parsnip::set_engine("glmnet")
modelo_elastic <-
parsnip::linear_reg(penalty = tune::tune(), mixture = tune::tune()) %>%
set_mode("regression") %>%
parsnip::set_engine("glmnet")
#workflow
all_wf <-
workflow_set(
preproc = list(y ~ . ),
models = list(mmo = modelo_mmo, ridge = modelo_ridge, lasso = modelo_lasso, elastic = modelo_elastic),
cross = TRUE
)
#cross-validation
set.seed(2023)
cv <- rsample::vfold_cv(trainer, v = 5L)
#metrics
metrica <- yardstick::metric_set(rmse)
#tunning
tunagem <-
all_wf %>%
workflow_map(
seed = 2023,
verbose = TRUE,
resamples = cv,
grid = 50,
metrics = metrica
)i No tuning parameters. `fit_resamples()` will be attemptedi 1 of 4 resampling: formula_mmo✔ 1 of 4 resampling: formula_mmo (221ms)i 2 of 4 tuning: formula_ridge✔ 2 of 4 tuning: formula_ridge (440ms)i 3 of 4 tuning: formula_lasso✔ 3 of 4 tuning: formula_lasso (441ms)i 4 of 4 tuning: formula_elastic✔ 4 of 4 tuning: formula_elastic (8.7s)Code
#melhores modelos
modelos_rank <- tunagem %>% rank_results()
melhor_mmo <-
tunagem %>%
extract_workflow_set_result("formula_mmo") %>%
select_best("rmse")
melhor_ridge <-
tunagem %>%
extract_workflow_set_result("formula_ridge") %>%
select_best("rmse")
melhor_lasso <-
tunagem %>%
extract_workflow_set_result("formula_lasso") %>%
select_best("rmse")
melhor_elastic <-
tunagem %>%
extract_workflow_set_result("formula_elastic") %>%
select_best("rmse")
finalizando_mmo <-
tunagem %>%
extract_workflow("formula_mmo") %>%
finalize_workflow(melhor_mmo) %>%
last_fit(split = wine)
finalizando_ridge <-
tunagem %>%
extract_workflow("formula_ridge") %>%
finalize_workflow(melhor_ridge) %>%
last_fit(split = wine)
finalizando_lasso <-
tunagem %>%
extract_workflow("formula_lasso") %>%
finalize_workflow(melhor_lasso) %>%
last_fit(split = wine)
finalizando_elastic <-
tunagem %>%
extract_workflow("formula_elastic") %>%
finalize_workflow(melhor_elastic) %>%
last_fit(split = wine)Code
knitr::kable(data.frame(row.names = c("MMO", "Ridge", "Lasso", "Elastic"),
"RMSE" = as.numeric(c((finalizando_mmo %>% collect_metrics())[1,3],
(finalizando_ridge %>% collect_metrics())[1,3],
(finalizando_lasso %>% collect_metrics())[1,3],
(finalizando_elastic %>% collect_metrics())[1,3])))
)| RMSE | |
|---|---|
| MMO | 0.6786656 |
| Ridge | 0.6786656 |
| Lasso | 0.6806660 |
| Elastic | 0.6802649 |
Code
data_temp <- data.frame(ychapeu_mmo = (finalizando_mmo %>% collect_predictions())[2],
ychapeu_ridge = (finalizando_ridge %>% collect_predictions())[2],
ychapeu_lasso = (finalizando_lasso %>% collect_predictions())[2],
ychapeu_elastic = (finalizando_elastic %>% collect_predictions())[2],
y = (finalizando_elastic %>% collect_predictions())[4]
)
colnames(data_temp) <- c("ychapeu_mmo", "ychapeu_ridge", "ychapeu_lasso", "ychapeu_elastic", "y")
data_temp <- as_tibble(data_temp)
graph <- ggplot(data_temp, aes(x = ychapeu_mmo, y = y)) +
geom_point() + geom_line(aes(y = ychapeu_mmo), colour = "red", size = 1) +
labs(title = "Reta ajustada", subtitle = "y_ajustado vs y_real do modelo MMO")
graph
Fazendo pelo GLMNET -
Code
rm(list = ls())
setwd("C:/Users/erald/Desktop/Faculdade/Aprendizagem de Maquina/machine_learning/")
wine <- read.csv("winequality-red.csv")
colnames(wine) <- c(paste0("x", 1:11), "y")
#Data split
wine <- initial_split(wine, prop = 3/4)
trainer <- training(wine)
tester <- testing(wine)
features <- trainer[,-12] %>% as.matrix()
ytrainer <- trainer[,12] %>% as.matrix()
testfeatures <- tester[,-12] %>% as.matrix()
ytest <- tester[,12] %>% as.matrix()
#MMO
fit <- glmnet(x = features, y = ytrainer, alpha = 0, lambda = 0)
preditos <- predict(fit, newx = testfeatures)
eqm_mmo <- mean((preditos - ytest)^2)
#Ridge
cvridge <- cv.glmnet(x = features, y = ytrainer, alpha = 0, nfolds = 5)
fit2 <- glmnet(x = features, y = ytrainer, alpha = 0)
preditos_ridge <- predict(fit2, s = cvridge$lambda.1se, newx = testfeatures)
eqm_ridge <- mean((preditos_ridge - ytest)^2)
#Lasso
cvlasso <- cv.glmnet(x = features, y = ytrainer, alpha = 1, nfolds = 5)
fit3 <- glmnet(x = features, y = ytrainer, alpha = 1)
preditos_lasso <- predict(fit3, s = cvlasso$lambda.1se, newx = testfeatures)
eqm_lass <- mean((preditos_lasso - ytest)^2)
#Elastic-net
#Precisamos estipular o melhor alpha através de uma validaçao cruzada.
#Utilizando 5-folds.
eqm_elastic <- NULL
alpha_values <- seq(0.01, 0.999, length.out = 500)
for(a in alpha_values){
cvelastic <- cv.glmnet(x = features, y = ytrainer, alpha = a, nfolds = 5)
tempfit <- glmnet(x = features, y = ytrainer, alpha = a)
preditos_elastic <- predict(tempfit, s = cvelastic$lambda.1se, newx = testfeatures)
eqm_elastic <- c(eqm_elastic,
mean((preditos_elastic - ytest)^2))
}
min(eqm_elastic)[1] 0.4219499[1] 0.9633246Code
| EQM | RMSE | |
|---|---|---|
| MMO | 0.4166706 | 0.6455003 |
| Ridge | 0.4395210 | 0.6629638 |
| Lasso | 0.4278124 | 0.6540737 |
| Elastic | 0.4219499 | 0.6495767 |
2.7 Questão:
Considere agora o conjunto de dados de despesas médicas. Refaça o mesmo exercício dos dados de vinho vermelho, em que aqui, o objetivo é prever a variável charges. Perceba que algumas variáveis são qualitativas, e portanto, você deverá transformá-las em dummy. Indique os melhores cenários dos quatro modelos e informe qual modelo você utilizaria. Explique! Dica: usando a função step_dummy() da biblioteca recipes, você poderá facilmente transformar variáveis qualitativas em numéricas.
Code
rm(list = ls())
setwd("C:/Users/erald/Desktop/Faculdade/Aprendizagem de Maquina/machine_learning/")
insurance <- read.csv("insurance.csv")
#Transformando qualitativas em numéricas
df <- recipe(charges ~., data = insurance) %>%
step_dummy(all_nominal(), -all_outcomes()) %>%
prep() %>% juice()
knitr::kable(df %>% head(10), format = "html")| age | bmi | children | charges | sex_male | smoker_yes | region_northwest | region_southeast | region_southwest |
|---|---|---|---|---|---|---|---|---|
| 19 | 27.900 | 0 | 16884.924 | 0 | 1 | 0 | 0 | 1 |
| 18 | 33.770 | 1 | 1725.552 | 1 | 0 | 0 | 1 | 0 |
| 28 | 33.000 | 3 | 4449.462 | 1 | 0 | 0 | 1 | 0 |
| 33 | 22.705 | 0 | 21984.471 | 1 | 0 | 1 | 0 | 0 |
| 32 | 28.880 | 0 | 3866.855 | 1 | 0 | 1 | 0 | 0 |
| 31 | 25.740 | 0 | 3756.622 | 0 | 0 | 0 | 1 | 0 |
| 46 | 33.440 | 1 | 8240.590 | 0 | 0 | 0 | 1 | 0 |
| 37 | 27.740 | 3 | 7281.506 | 0 | 0 | 1 | 0 | 0 |
| 37 | 29.830 | 2 | 6406.411 | 1 | 0 | 0 | 0 | 0 |
| 60 | 25.840 | 0 | 28923.137 | 0 | 0 | 1 | 0 | 0 |
Code
df <- initial_split(df, prop = 3/4)
trainer <- training(df)
tester <- testing(df)
#Setting Engine
modelo_mmo <-
linear_reg(penalty = 0, mixture = 0) %>%
set_mode("regression") %>%
set_engine("glmnet")
modelo_ridge <-
linear_reg(penalty = tune::tune(), mixture = 0) %>%
set_mode("regression") %>%
set_engine("glmnet")
modelo_lasso <-
parsnip::linear_reg(penalty = tune::tune(), mixture = 1) %>%
set_mode("regression") %>%
parsnip::set_engine("glmnet")
modelo_elastic <-
parsnip::linear_reg(penalty = tune::tune(), mixture = tune::tune()) %>%
set_mode("regression") %>%
parsnip::set_engine("glmnet")
#workflow
all_wf <-
workflow_set(
preproc = list(charges ~ . ),
models = list(mmo = modelo_mmo, ridge = modelo_ridge, lasso = modelo_lasso, elastic = modelo_elastic),
cross = TRUE
)
#cross-validation
set.seed(2023)
cv <- rsample::vfold_cv(trainer, v = 5L)
#metrics
metrica <- yardstick::metric_set(rmse)
#tunning
tunagem <-
all_wf %>%
workflow_map(
seed = 2023,
verbose = TRUE,
resamples = cv,
grid = 50,
metrics = metrica
)i No tuning parameters. `fit_resamples()` will be attemptedi 1 of 4 resampling: formula_mmo✔ 1 of 4 resampling: formula_mmo (140ms)i 2 of 4 tuning: formula_ridge✔ 2 of 4 tuning: formula_ridge (421ms)i 3 of 4 tuning: formula_lasso✔ 3 of 4 tuning: formula_lasso (420ms)i 4 of 4 tuning: formula_elastic✔ 4 of 4 tuning: formula_elastic (8.6s)Code
#melhores modelos
modelos_rank <- tunagem %>% rank_results()
melhor_mmo <-
tunagem %>%
extract_workflow_set_result("formula_mmo") %>%
select_best("rmse")
melhor_ridge <-
tunagem %>%
extract_workflow_set_result("formula_ridge") %>%
select_best("rmse")
melhor_lasso <-
tunagem %>%
extract_workflow_set_result("formula_lasso") %>%
select_best("rmse")
melhor_elastic <-
tunagem %>%
extract_workflow_set_result("formula_elastic") %>%
select_best("rmse")
finalizando_mmo <-
tunagem %>%
extract_workflow("formula_mmo") %>%
finalize_workflow(melhor_mmo) %>%
last_fit(split = df)
finalizando_ridge <-
tunagem %>%
extract_workflow("formula_ridge") %>%
finalize_workflow(melhor_ridge) %>%
last_fit(split = df)
finalizando_lasso <-
tunagem %>%
extract_workflow("formula_lasso") %>%
finalize_workflow(melhor_lasso) %>%
last_fit(split = df)
finalizando_elastic <-
tunagem %>%
extract_workflow("formula_elastic") %>%
finalize_workflow(melhor_elastic) %>%
last_fit(split = df)
knitr::kable(data.frame(row.names = c("MMO", "Ridge", "Lasso", "Elastic"),
"RMSE" = as.numeric(c((finalizando_mmo %>% collect_metrics())[1,3],
(finalizando_ridge %>% collect_metrics())[1,3],
(finalizando_lasso %>% collect_metrics())[1,3],
(finalizando_elastic %>% collect_metrics())[1,3])))
)| RMSE | |
|---|---|
| MMO | 6032.497 |
| Ridge | 6032.497 |
| Lasso | 6046.101 |
| Elastic | 6046.310 |
Code
data_temp <- data.frame(ychapeu_mmo = (finalizando_mmo %>% collect_predictions())[2],
ychapeu_ridge = (finalizando_ridge %>% collect_predictions())[2],
ychapeu_lasso = (finalizando_lasso %>% collect_predictions())[2],
ychapeu_elastic = (finalizando_elastic %>% collect_predictions())[2],
y = (finalizando_elastic %>% collect_predictions())[4]
)
colnames(data_temp) <- c("ychapeu_mmo", "ychapeu_ridge", "ychapeu_lasso", "ychapeu_elastic", "y")
data_temp <- as_tibble(data_temp)
g1 <- ggplot(data_temp, aes(x = ychapeu_mmo, y = y)) +
geom_point() + geom_line(aes(y = ychapeu_mmo), colour = "#191970", size = 1) +
labs(title = "Modelo MMO", subtitle = "y_ajustado vs y_real")
g2 <- ggplot(data_temp, aes(x = ychapeu_ridge, y = y)) +
geom_point() + geom_line(aes(y = ychapeu_ridge), colour = "#4169E1", size = 1) +
labs(title = "Modelo ridge", subtitle = "y_ajustado vs y_real")
g3 <- ggplot(data_temp, aes(x = ychapeu_lasso, y = y)) +
geom_point() + geom_line(aes(y = ychapeu_lasso), colour = "orange", size = 1) +
labs(title = "Modelo lasso", subtitle = "y_ajustado vs y_real")
g4 <- ggplot(data_temp, aes(x = ychapeu_elastic, y = y)) +
geom_point() + geom_line(aes(y = ychapeu_elastic), colour = "red", size = 1) +
labs(title = "Modelo elastic", subtitle = "y_ajustado vs y_real")
(g1 + g2) / (g3 + g4)
resposta: Escolheria o modelo de Regressão Elastic pelo fato da raiz quadrada do erro quadrado médio ser o menor entre os 3 modelos anteriores. Além disso, ele foi o que mais rápido se ajustou aos dados.